home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Memphis Amiga Group / MAG Disk (1989-11)(Memphis Amiga Group).zip / MAG Disk (1989-11)(Memphis Amiga Group).adf / HeadClean / headclean.f < prev    next >
Text File  |  1986-11-06  |  7KB  |  246 lines
  1. \ Clean a drive by trying to format several cylinders
  2. \ on a fibre cleaning disk
  3. \ The last cylinder used will be kept in a file called
  4. \   HEADCLEAN.LOG
  5.  
  6. \ Author: Phil Burk
  7. \ Copyright 1987,8,9 Phil Burk
  8. \
  9. \ This program is a freely redistributable shareware program.
  10.  
  11. \ Files from HeadClean Directory
  12. include? td.format disk_support
  13. include? tdt.init disk_tools
  14. include? gt.process.events gadget_tools
  15. include? $hc.msg hc_base
  16. include? drive.buttons.init hc_drive_gads
  17.  
  18. ANEW TASK-HeadClean
  19.  
  20. \ ----------------------------------------------------
  21. \ Graphical User Interface Portion of code.
  22.  
  23. \ Support for GO gadget.
  24. : HC.ALL.USED ( -- )
  25.     " This disk is used up. You may want to buy a new one."
  26.     $HC.MSG
  27.     0 clean-start !
  28. ;
  29.  
  30. : CHECK.START ( -- , correct start cylinder if bad )
  31.     clean-start @ NUMCYLS 1- clean_#cyl - >
  32.     IF hc.all.used
  33.     THEN
  34. ;
  35.  
  36. : HC.GO  ( -- , clean disk
  37.     check.start
  38.     <headclean>
  39.     check.start
  40. ;
  41.  
  42. \ ------------------------------------------------
  43. \ Support for HELP gadget.
  44. variable HC-CURY
  45.  
  46. : HC.LINE  ( text -- , new line of graphics )
  47.     10 hc-cury @ gr.move
  48.     gr.text
  49.     hc_line_height hc-cury +!
  50. ;
  51.  
  52. variable HC-WINDOW
  53.  
  54. : HC.HELP.TEXT1 ( -- , display first help screen )
  55.     1 gr.color!
  56.     hc_banner_y1 hc-cury !  ( set y pos )
  57.     " HeadClean V2.0 is designed to work with any fibre" hc.line    
  58.     " cleaning disk.  Read directions for your cleaning" hc.line
  59.     " disk first.  Then apply cleaning liquid and place" hc.line
  60.     " disk in drive to be cleaned. Then select drive" hc.line
  61.     " with mouse and select 'GO!'. Every cleaning will" hc.line
  62.     " use 4 cylinders of the disk. The next cylinder" hc.line
  63.     " to use will be written to the file HeadClean.LOG." hc.line
  64.     " When every cylinder has been used you may want" hc.line
  65.     " to buy a new cleaning disk, or keep using it over" hc.line
  66.     " and over.  Clean your heads after every 40 hours" hc.line
  67.     " of use, or if you start getting Read/Write errors." hc.line
  68.     "  " hc.line
  69.     " Click in CloseBox to continue" hc.line
  70. ;
  71.  
  72. : HC.HELP.TEXT2 ( -- )
  73.     gr.clear
  74.     1 gr.color!
  75.     hc_banner_y1 hc-cury !
  76.     " HeadClean was written using JForth Professional 2.0," hc.line
  77.     " a powerful and fast interactive programming language." hc.line
  78.     " For more information, write or phone:" hc.line
  79.     3 gr.color!
  80.     "  " hc.line
  81.     "     Delta Research" hc.line
  82.     "     P.O. Box 1051" hc.line
  83.     "     San Rafael, CA, 94915" hc.line
  84.     "     (415) 485-6867" hc.line
  85.     "  " hc.line
  86.     1 gr.color!
  87.     " HeadClean V2.0 is shareware.  If you find this" hc.line
  88.     " program useful please send a check for $10.00" hc.line
  89.     " payable to Phil Burk at the above address." hc.line
  90.     " HeadClean V2.0 may be freely restributed." hc.line
  91. ;
  92.  
  93. newWindow HC-NewWindow
  94.  
  95. : HC.HELP ( -- , Draw explanatory help in separate window )
  96.     hc-newwindow newwindow.setup
  97.     hc_window_w hc-NewWindow ..! nw_width
  98.     160 hc-NewWindow ..! nw_height
  99. \ Set new title.
  100.     0" HeadClean Help"
  101.         >abs  hc-NewWindow ..! nw_title
  102. \
  103.     hc-NewWindow gr.opencurw
  104.     IF  hc.help.text1
  105.         BEGIN ?closebox
  106.         UNTIL
  107.         hc.help.text2
  108.         BEGIN ?closebox
  109.         UNTIL
  110.         gr.closecurw
  111. \
  112.         hc-window @ ?dup
  113.         IF gr.set.curwindow
  114.         THEN
  115.     ELSE " Insufficient memory for HELP window!" $hc.msg
  116.     THEN
  117. ;
  118.  
  119. \ Main Graphics support --------------------------------
  120. : HC.DRAW.BANNER ( -- )
  121.     1 gr.color!
  122.     hc_banner_y1 hc-cury !
  123.     " Written by Phil Burk using JForth Professional 2.0"
  124.     hc.line
  125.     " from Delta Research, Box 1051, San Rafael, CA, 94915"
  126.     hc.line
  127.     " Select which drive to clean, then hit 'GO!'."
  128.     hc.line
  129. ;
  130.  
  131. : HC.REDRAW  ( -- , redraw graphics )
  132.     gr.clear
  133.     1 gr.color!
  134.     hc.draw.banner
  135.     hc.report.left
  136.     hc.show.drive
  137.     gt.refresh
  138. ;
  139.  
  140. : HC.GADS.INIT ( -- , initialize gadgets for demo )
  141. \  define border of gadgets.
  142.     boolg-xys >abs boolg-border ..! bd_xy
  143.     hc_w_h boolg-border border.setup
  144. \
  145. \ Declare text, CFA, and size for each gadget.
  146.     0 first-gadget !
  147.     ' hc.go      0" Go!"
  148.     hc_gadget_x hc_gadget_inc 5 * + hc_gadget_y hc_w_h  gt.gad.make
  149.     ' hc.help    0" Help"
  150.     hc_gadget_x hc_gadget_inc 6 * + hc_gadget_y hc_w_h  gt.gad.make
  151. \
  152.     drive.buttons.init
  153. \
  154. \ Set defaults for newwindow
  155.     hc-NewWindow newwindow.setup
  156.     hc_window_w hc-NewWindow ..! nw_width
  157.     hc_window_h hc-NewWindow ..! nw_height
  158. \
  159. \ Link gadget list to window.
  160.     first-gadget @ >abs hc-NewWindow ..! nw_firstgadget
  161. \
  162. \ Set new title.
  163.     0" -< HeadClean V2.0 -- Shareware >-"
  164.         >abs  hc-NewWindow ..! nw_title
  165. \
  166. \ Set flags for gadget events.
  167.     CLOSEWINDOW  GADGETDOWN | GADGETUP |
  168.     hc-NewWindow ..! nw_idcmpflags
  169. ;
  170.  
  171. : HC.LOOP  ( -- , process mouse events until done )
  172.     BEGIN
  173.         gr-curwindow @ ev.wait
  174.         gr-curwindow @ ev.getclass dup
  175.         IF gt.process.event ( -- done? )
  176.         THEN
  177.     UNTIL
  178. ;
  179.  
  180. \ Read and write starting cylinder to a log file --------------
  181. : HC_FILENAME ( -- $name )
  182.     " RAM:HeadClean.log"
  183. ;
  184.  
  185. : HC.READ.START ( -- , read start from log file or set to -1 )
  186.     hc_filename $fopen ?dup
  187.     IF  dup clean-start 4 fread 4 -  ( unformatted 4 byte read )
  188.         IF " Could not find HeadClean.log file. Start at 0"
  189.            $HC.MSG
  190.            0 clean-start !
  191.         THEN
  192.         fclose
  193.     ELSE  " Could not find HeadClean.log file. Start at 0"
  194.            $HC.MSG
  195.            0 clean-start !
  196.     THEN
  197. ;
  198.  
  199. : HC.WRITE.START ( -- , write start to log file or set to -1 )
  200.     new hc_filename $fopen ?dup
  201.     IF  dup clean-start 4 fwrite drop  ( unformatted 4 byte read )
  202.         fclose
  203.     THEN
  204. ;
  205.  
  206. \ Main control words ----------------------------
  207. \ I strongly recommend structuring your programs
  208. \ with a separate INIT and TERM word
  209. \ and a simple Main word that does both.
  210. \ This greatly simplifies testing bacause
  211. \ you can INIT completely then test interactively
  212. \ withou running the program.
  213.     
  214. : HC.INIT  ( -- ok? , initialize EVERYTHING )
  215.     gr.init
  216.     hc.gads.init
  217.     hc-NewWindow gr.opencurw dup
  218.     IF  gr-curwindow @ hc-window !
  219.         hc.read.start
  220.         check.start
  221.         arrow.init
  222.         0 hc.drive
  223.     hc.redraw
  224.     THEN
  225. ;
  226.  
  227. : HC.TERM ( -- , clean up SAFELY )
  228.     arrow.term
  229.     gr.closecurw
  230.     hc-window off
  231.     hc.write.start
  232.     gt.free.all
  233. ;
  234.  
  235. : HEADCLEAN ( -- , main entry point )
  236.     hc.init
  237.     IF  hc.loop
  238.     THEN
  239.     hc.term
  240. ;
  241.  
  242. \ Automatically clean up if FORGET used.
  243. if.forgotten HC.TERM
  244.  
  245. cr ." Enter:   HEADCLEAN     to clean drive heads." cr
  246.